home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvicon.exe / ICON.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-28  |  4KB  |  142 lines
  1. Unit Icon;
  2. {                                                                        }
  3. {  Turbo Vision "Icons"                                                  }
  4. {                                                                        }
  5. {  This unit implements an icon object for Turbo Vision. These are small }
  6. {  views containing simple text and are intended to be inserted into the }
  7. {  Application (as opposed to the DeskTop) so that they float "on top"   }
  8. {  of everything else. They also cannot be moved out of sight except by  }
  9. {  covering one with another. TIcon defines a DoubleClick method that    }
  10. {  is called whenever a mouse double-click event occurs. By default, it  }
  11. {  does nothing - override it to provide whatever function you want,     }
  12. {  such as opening more windows, dialogs and so on.                      }
  13. {                                                                        }
  14. {  TIcon supports highlighting of its text (using ~ characters), but     }
  15. {  does NOT respond in any way to keyboard events and cannot be selected.}
  16. {  In my applications, I use it as a mouse-only alternative to menu      }
  17. {  selections. TIcons can be moved by dragging with a mouse and can be   }
  18. {  loaded and stored, though you must call RegisterIcon before you use   }
  19. {  them in streams. The text displayed in the icon is supplied in the    }
  20. {  Init call and will be crudely fitted into as many lines as will fit   }
  21. {  in the Bounds. An enhanced version could, for example, work more like }
  22. {  TStaticText and do centering, line-breaks and so on.                  }
  23. {                                                                        }
  24. {  This code is released into the Public Domain and may be used for any  }
  25. {  purpose. If you have comments or questions, I can be reached at:      }
  26. {                                                                        }
  27. {     David Babler (Orion Digital Systems)                               }
  28. {     CIS: 75076,1204                                                    }
  29. {     BBS: 206 693-5365  Voice: 206 892-3612                             }
  30. {                                                                        }
  31.  
  32. INTERFACE
  33. Uses
  34.   Drivers,
  35.   Objects,
  36.   Views;
  37.  
  38. Type
  39.   PIcon         = ^TIcon;
  40.   TIcon         = Object (TView)
  41.     Title       : PString;
  42.  
  43.     Constructor Init (var Bounds : TRect; Const ATitle : string);
  44.     Constructor Load (var S : TStream);
  45.     Destructor  Done;
  46.       virtual;
  47.     Procedure   Store (var S : TStream);
  48.       virtual;
  49.     Procedure   Draw;
  50.       virtual;
  51.     Procedure   HandleEvent (var Event : TEvent);
  52.       virtual;
  53.     Procedure   DoubleClick;
  54.       virtual;
  55.   end;
  56.  
  57. Procedure RegisterIcon;
  58.  
  59. IMPLEMENTATION
  60.  
  61. Uses
  62.   Dialogs,
  63.   Strings;
  64.  
  65. Const
  66.   RIcon : TStreamRec =
  67.    (ObjType: 9000;
  68.     VmtLink: Ofs(TypeOf(TIcon)^);
  69.     Load:    @TIcon.Load;
  70.     Store:   @TIcon.Store);
  71.  
  72. {---  TICon's Methods  ---}
  73.  
  74. Constructor TIcon.Init (var Bounds : TRect; Const ATitle : string );
  75. begin
  76.   Inherited Init(Bounds);
  77.   DragMode := dmLimitAll;
  78.   SetState(sfShadow,true);
  79.   Title := NewStr(ATitle);
  80. end;
  81.  
  82. Constructor TIcon.Load (var S : TStream);
  83. begin
  84.   Inherited Load(S);
  85.   Title := S.ReadStr;
  86. end;
  87.  
  88. Destructor TIcon.Done;
  89. begin
  90.   DisposeStr(Title);
  91.   Inherited Done;
  92. end;
  93.  
  94. Procedure TIcon.Store (var S : TStream);
  95. begin
  96.   Inherited Store(S);
  97.   S.WriteStr(Title);
  98. end;
  99.  
  100. Procedure TIcon.Draw;
  101. Var
  102.   B  : TDrawBuffer;
  103.   C  : Word;
  104. begin
  105.   C := GetColor($6766);
  106.   MoveChar(B,' ',C,Size.X * Size.Y);
  107.   MoveCStr(B[1],Title^,C);
  108.   WriteBuf(0,0,Size.X,Size.Y,B);
  109. end;
  110.  
  111. Procedure TIcon.HandleEvent (var Event : TEvent);
  112. Var
  113.   R       : TRect;
  114.   Min,Max : TPoint;
  115. begin
  116.   Inherited HandleEvent(Event);
  117.  
  118.   if Event.What and evMouseDown = evMouseDown then
  119.   begin
  120.     if Event.Double then DoubleClick
  121.     else begin
  122.       Owner^.GetExtent(R);
  123.       R.Grow(0,-1);
  124.       SizeLimits(Min,Max);
  125.       DragView(Event,dmDragMove or DragMode,R,Min,Max);
  126.       ClearEvent(Event);
  127.     end;
  128.   end;
  129. end;
  130.  
  131. Procedure TIcon.DoubleClick;
  132. begin
  133.   { override to perform specific action on double-click }
  134. end;
  135.  
  136. Procedure RegisterIcon;
  137. begin
  138.   RegisterType(RIcon);
  139. end;
  140.  
  141.  
  142. end.